unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, StdCtrls, xmldom, XMLIntf, ExtCtrls, msxmldom,
  XMLDoc, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, CoolTrayIcon, TextTrayIcon, icecast2, INIFiles;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Setup1: TMenuItem;
    Help1: TMenuItem;
    Exit1: TMenuItem;
    About1: TMenuItem;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    LV: TListView;
    IdHTTP1: TIdHTTP;
    XMLDoc: TXMLDocument;
    Timer1: TTimer;
    TTI: TTextTrayIcon;
    CheckBox1: TCheckBox;
    Memo1: TMemo;
    CView: TListView;
    Clients: TLabel;
    ClientKick: TPopupMenu;
    Kick1: TMenuItem;
    MountsMenu: TPopupMenu;
    Listclients1: TMenuItem;
    Updatemetadata1: TMenuItem;
    Killsource1: TMenuItem;
    Moveclients1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure Setup1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Listclients1Click(Sender: TObject);
    procedure MountsMenuPopup(Sender: TObject);
    function SecToTime(Sec: Integer): string;
    function SplitStrings(const str: string; const separator: string; Strings: TStrings): TStrings;
    procedure About1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  icecast2: TIcecast2;

implementation

uses Unit3;

{$R *.dfm}

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.Setup1Click(Sender: TObject);
begin
  SetupForm.visible:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  myINI : TINIFile;
  config: string;

begin
  config:=ExtractFilePath(Application.EXEName) + 'iceadmin.ini';
  myINI := TINIFile.Create(config);
  icecast2.user:=myINI.ReadString('General','username','');
  icecast2.pass:=myINI.ReadString('General','password','');
  icecast2.adminurl:=myINI.ReadString('General','adminurl','');
  icecast2.xmlstatsurl:=icecast2.adminurl+myINI.ReadString('General','xmlstatsurl','stats');
  icecast2.listclientsurl:=icecast2.adminurl+myINI.ReadString('General','listclientsurl','listclients.xsl');
  icecast2.kickclienturl:=icecast2.adminurl+myINI.ReadString('General','kickclienturl','killclient.xsl');
  icecast2.pollint:=myINI.ReadInteger('General','poll_interval',4);
  myINI.Free;
  memo1.Clear;
  idhttp1.Request.Username:=icecast2.user;
  idhttp1.request.Password:=icecast2.pass;
  idhttp1.request.BasicAuthentication:=true;
  timer1.Interval:=icecast2.pollint * 1000;
  timer1.Enabled:=CheckBox1.Checked;
  TTI.ShowBalloonHint('Init','hi there!',bitInfo,10);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  // for parsing serverstats XML output
  msg : string;
  StartItemNode : IXMLNode;
  ANode : IXMLNode;
  mount, listeners, max_listeners: String;

  // for parsing listclients.xsl HTML output
  buffer: string;
  a,b,c,d:  string;
  i,j,k,l:  integer;
  check:    boolean;
  Clients:       TStringList;
  Client:        TStringList;
  temp:          TStringList;
begin
//  timer1.Enabled:=false;
//  checkbox1.Checked:=false;
  StatusBar1.Panels[1].Text:='Fetching...';
  msg:=(IdHTTP1.Get(icecast2.xmlstatsurl));
  StatusBar1.Panels[1].Text:='Fetching... XML...';
  XMLDoc.CleanupInstance;
  XMLDOc.XML.Text:=msg;
  XMLDoc.Active:=true;
  StatusBar1.Panels[1].Text:='Fetching... XML... Parsing';
//foo
  StartItemNode:=XMLDoc.ChildNodes.FindNode('icestats').ChildNodes.FindNode('source');
  ANode := StartItemNode;


  //see TForm1.MountsMenuPopup
  LV.Items.Clear;

  check:=false;

  repeat
    mount := ANode.AttributeNodes.Nodes['mount'].Text;
    listeners := Anode.ChildNodes['listeners'].Text;
    max_listeners := ANode.ChildNodes['title'].Text;

    if (mount = icecast2.mountselected) AND (StrToInt(listeners) > 0) then
      begin
        check:=true;
        TTI.Text:=listeners;
      end;

    with LV.Items.Add do
    begin
      Caption := mount;
      SubItems.Add(listeners);
      SubItems.Add(max_listeners)
    end;
    ANode := ANode.NextSibling;
  until ANode = nil;

  msg:='';
  XMLDoc.Active:=false;
  StatusBar1.Panels[1].Text:='Fetching... XML... Parsing... Done';

  if (check = false) then
    begin
      CView.Items.Clear;
      TTI.Text:=listeners;
    end
    else
    begin
    //TODO: encode HTTP GET request properly in case of special characters in icecast2.mountselected
      buffer:=IdHTTP1.Get(icecast2.listclientsurl+'?mount='+icecast2.mountselected);
      //TODO: clean up HTML parser
      i:=Pos('<center><b>Action</b></center></td></tr><tr>',buffer);
      j:=Pos('Kick</a></td></tr></t',buffer);
      a:=Copy(buffer,i,(j-i));

      // #2 - start of text
      // #3 - end of text
      // #10 in #13 - LF in CR
      // #30 - record separator
      // #31 - unit separator

      //start of clients table
      a:=StringReplace(a,'<b>Action</b></center></td></tr><tr><td align="center">','',[rfReplaceAll]);
      //record end for previous and record start for next client
      a:=StringReplace(a,'Kick</a></td></tr><tr><td align="center">',#30,[rfReplaceAll]);
      //record end for previous client and no more records
      a:=StringReplace(a,'Kick</a></td></tr></tbody></table><br><br>','',[rfReplaceAll]);
      a:=StringReplace(a,'<center>','',[rfReplaceAll]);
      a:=StringReplace(a,'</center>','',[rfReplaceAll]);
      a:=StringReplace(a,'<b>','',[rfReplaceAll]);
      a:=StringReplace(a,'</b>','',[rfReplaceAll]);
      a:=StringReplace(a,'<tr>','',[rfReplaceAll]);
      a:=StringReplace(a,'</tr>','',[rfReplaceAll]);
      a:=StringReplace(a,'<td>','',[rfReplaceAll]);
      a:=StringReplace(a,'</td>','',[rfReplaceAll]);
      a:=StringReplace(a,'</a>','',[rfReplaceAll]);
      a:=StringReplace(a,'<td align="center">',#31,[rfReplaceAll]);
      a:=StringReplace(a,'<a href="','',[rfReplaceAll]);
      a:=StringReplace(a,'">','',[rfReplaceAll]);
      a:=StringReplace(a,#10,'',[rfReplaceAll]);

      Clients := TStringList.Create;

      //clear Clients ListView table as we have new data
      CView.Items.Clear;

      try
        SplitStrings(a,#30,Clients);
        k:=Clients.Count;
        for L := 0 to k-1 do
          begin
            Client := TStringList.Create;
            temp := TstringList.Create;

            b:=Clients[L];
            SplitStrings(b,#31,Client);

            Client[0]:=StringReplace(Client[0],'(','',[rfReplaceAll]);
            Client[0]:=StringReplace(Client[0],')','',[rfReplaceAll]);
            SplitStrings(Client[0],' ',temp);

            Client[1]:=StringReplace(Client[1],' seconds','',[rfReplaceAll]);

            CView.Items.Add;
            CView.Items.Item[L].Caption:=temp[0];
            CView.Items.Item[L].SubItems.Add(temp[1]);
            CView.Items.Item[L].SubItems.Add(SecToTime(StrToInt(Client[1])));
            CView.Items.Item[L].SubItems.Add(Client[2]);
            CView.Items.Item[L].SubItems.Add(Client[3]);

            Client.free;
            temp.free;
          end;
      finally
        Clients.Free;
      end;

  end;

end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  timer1.Enabled:=CheckBox1.Checked;
end;




procedure TForm1.Listclients1Click(Sender: TObject);
var
  s : string;
begin
  icecast2.mountselected:=icecast2.temp;
end;

procedure TForm1.MountsMenuPopup(Sender: TObject);
var
  s : string;
begin
  if (LV.SelCount > 0) then
    begin
      //because LV.Clear in Timer1Timer
      icecast2.temp:=LV.Selected.Caption;
    end;

end;

function TForm1.SplitStrings(const str: string; const separator: string; Strings: TStrings): TStrings;
  // Fills a string list with the parts of "str" separated by
  // "separator". If Nil is passed instead of a string list,
  // the function creates a TStringList object which has to
  // be freed by the caller
  var
    n: integer;
    p, q, s: PChar;
    item: string;
  begin
    if Strings = nil then
      Result := TStringList.Create
    else
      Result := Strings;
    try
      p := PChar(str);
      s := PChar(separator);
      n := Length(separator);
      repeat
        q := StrPos(p, s);
        if q = nil then q := StrScan(p, #0);
        SetString(item, p, q - p);
        Result.Add(item);
        p := q + n;
      until q^ = #0;
    except
      item := '';
      if Strings = nil then Result.Free;
      raise;
    end;
  end;

function TForm1.SecToTime(Sec: Integer): string;
var
   H, M, S: string;
   ZH, ZM, ZS: Integer;
begin
   ZH := Sec div 3600;
   ZM := Sec div 60 - ZH * 60;
   ZS := Sec - (ZH * 3600 + ZM * 60) ;
   if ZH < 10 then H:='0' + IntToStr(ZH) else H := IntToStr(ZH) ;
   if ZM < 10 then M:='0' + IntToStr(ZM) else M := IntToStr(ZM) ;
   if ZS < 10 then S:='0' + IntToStr(ZS) else S := IntToStr(ZS) ;
   Result := H + ':' + M + ':' + S;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  ShowMessage('marko.rizvic@gmail.com'+#13+#10+'http://code.google.com/p/iceadmin/');
end;

end.
